perm filename FILLER.OLD[MSS,LCS]1 blob
sn#049524 filedate 1974-01-08 generic text, type T, neo UTF8
00100 SUBROUTINE FILLER
00200 COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
00300 COMMON /RZ/RSZ,IPLT,RJB,CENTR
00400 COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
00500 DATA RC/1./
00600 PX=2
00610 IF(MFILL(1).GT.60)PX=3
00700 CNZ=RSZ
00800 DNZ=1.0
00900 IF(IPLT.GE.0)GO TO 101
01000 IF(IXRX.EQ.1)DNZ=1.1
01100 PX=1
01200 CNZ=1.7*CNZ
01400 C DNZ IS TO FATTEN IT ON THE XGP
01450 101 FNZ=CNZ*DNZ
01500 RBZ=RJB*CNZ*DNZ
01600 C 1.7 IS FOR THIS TEST PROG. ONLY
01700 NX=2
01800 C NX IS POINTER IN X ARRAY
01950 ID=MFILL(NX)
02000 100 RM=-1000
02100 I=NX+1
02200 103 CALL UNPACK(I,IA,IB,MFILL)
02210 IF(IA.NE.MFILL(I+1)/10000)GO TO 102
02220 I=I+1
02230 GO TO 103
02300 102 G=IA+RJB
02400 H=IB+CENTR
02500 IF(IPLT)GO TO 200
02600 CALL LINES(G,H,3)
02700 GO TO 300
03500 200 IF(IXRX.EQ.0)GO TO 90
03600 M=ROFF(-H*CNZ)
03700 N=ROFF(G*FNZ+XGP)
03800 GO TO 80
03900 90 M=ROFF(G*CNZ)
04000 N=(H*CNZ)
04100 80 CALL PLOT(M,N,3)
04200 C X POINTER
04300 300 NN=ID-1
04400 C LAST OF ARRAY-1
04500 P=IA*FNZ
04600 CALL UNPACK(I+1,IG,H,MFILL)
04700 RB=IG*FNZ+PX
04710 CC RB=IG*FNZ+PX-1
04800 J=1
04900 1 JJ=1
05010 IF(RM.GT.RB)GO TO 13
05100 IF(J)GO TO 2
05200 3 CALL NNN(NN,1,0)
05300 C FINDS BOTTOM POINTER
05400 GO TO 16
05500 2 CALL NNN(I,0,1)
05600 C FINDS TOP POINTER(I)
05700 16 CALL UNPACK(N,JA,JB,MFILL)
05800 CALL UNPACK(N+1,JG,JH,MFILL)
05900 CALL UNPACK(NQ,IQ,H,MFILL)
06000 RZ=RZ*FNZ
06010 IF(P.GT.RZ)P=RZ
06100 Q=IQ*FNZ
06200 C=(IC+CENTR)*CNZ
06300 10 DIS=JA-JG
06400 IF(DIS.NE.0)GO TO 6
06500 C FOR STRAIIGHT UP-DOWN LINES
06550 IF(NN-1.EQ.I)GO TO 13
06600 P=P-PX
06700 GO TO 50
06800 6 H=(JB-JH)/(DIS*DNZ)
06807 C MOVES ONLY LEFT TO RIGHT
06810 11 HH=(P-Q)*H+C
06820 1111 PP=P+RBZ
06900 IH=ROFF(HH)
07000 IP=ROFF(PP)
07005 C RN IS FOR ROUND-OFF ERRORS
07010 IF(IP.EQ.MP.AND.IH.EQ.MH)GO TO 180
07020 MP=IP
07030 MH=IH
07040 C OMITS REPEATED POINTS
07100 IF(IPLT)GO TO 17
07200 CALL AVECT(IP,IH)
07300 GO TO 180
07400 17 IF(IXRX.EQ.0)GO TO 19
07500 K=IP
07600 IP=-IH
07700 IH=K+XGP
07800 19 CALL PLOT(IP,IH,2)
08100 180 JJ=JJ-1
08200 IF(JJ)GO TO 12
08250 RM=P
08300 P=P+PX
08510 IF(P.LT.RZ)GO TO 11
08600 5 CALL DPYOUT(1)
08700 50 IF(J)GO TO 4
08800 NN=NN-1
08850 IF(I.GT.NN)GO TO 13
08900 GO TO 3
09000 4 I=I+1
09050 IF(I.GT.NN)GO TO 13
09100 CALL UNPACK(I+1,IA,IB,MFILL)
09200 RB=IA*FNZ+PX
09210 CC RB=IA*FNZ+PX-1
09300 GO TO 2
09400 12 J=-J
09500 GO TO 1
09600 13 NX=ID+1
09705 IF(ID.EQ.MFILL(1))GO TO 130
09710 ID=MFILL(NX)
09800 GO TO 100
09900 130 CALL DPYOUT(1)
09910 MP=1000
09920 MH=1000
10000 RETURN
10100 14 FORMAT(2I4)
10200 END
10300 SUBROUTINE NNN(J,L,K)
10400 COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
10500 COMMON /RZ/RSZ,IPLT,RJB,CENTR
10600 COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
10700 CALL UNPACK(J+K,IZ,IC,MFILL)
10800 CALL UNPACK(J+L,N,IC,MFILL)
11000 N=J
11100 C C IS THE CONSTANT
11300 NQ=N+L
11320 RZ=IZ
11400 RETURN
11500 END
11600
11700 FUNCTION ROFF(R)
11800 S=.5
11900 IF(R)S=-S
12000 ROFF=R+S
12100 RETURN
12200 END